home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / a / a_funk / hammap1.tos / DIGI_MAP / DIGIMAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-17  |  37.6 KB  |  1,072 lines
  1. {$S60}
  2. {$C-,D-,P-,T+}
  3.  
  4. PROGRAM Digi_Info;
  5.  
  6.  
  7.   CONST
  8.  
  9.     Version        = ' Ver 1.4.KH TOS';               (* Version *)
  10.     Date           = 'AUGUST 92';                     (* Versionsdatum *)
  11.     MaxDigi        = 2500;                            (* Anzahl der Digipeater *)
  12.     MaxLink        = 6000;                            (* Maximale Anzahl der Links *)
  13.     Link_Depth     = 30;                              (* Maximale Linktiefe *)
  14.     pi             = 3.14156;
  15.  
  16.   type namens_typ   = packed array[1 .. 80] of char;
  17.   
  18.        dta_typ      = packed record
  19.                         reserved  : packed array[0 .. 19] of byte;
  20.                         reserved1 : byte;
  21.                         attribut  : byte;
  22.                         zeit      : integer;
  23.                         datum     : integer;
  24.                         laenge    : long_integer;
  25.                         name      : packed array[1 .. 14] of char
  26.                       end;
  27.                       
  28.        t_link_array = array[0 .. maxlink] of integer;
  29.        
  30.        t_s9         = array[0 .. maxdigi] of string[9];
  31.        
  32.        t_s7         = array[0 .. maxdigi] of string[7];
  33.        
  34.        t_s2         = array[0 .. maxdigi] of string[2];
  35.        
  36.        t_r          = array[0 .. maxdigi] of real;
  37.        
  38.        t_lm         = packed array[0 .. maxlink] of boolean;
  39.        
  40.        t_dm         = packed array[0 .. maxdigi] of boolean;
  41.        
  42.        t_save_rec   = record
  43.                         testmaxdigi, testmaxlink : integer;
  44.                         anz_digis,anz_links      : integer;
  45.                         link_start,link_end,
  46.                         link_gamma               : t_link_array;
  47.                         call                     : t_s9;
  48.                         qth,qrg                  : t_s7;
  49.                         typ                      : t_s2;
  50.                         ost,nord                 : t_r
  51.                       end;
  52.                       
  53.   
  54.  (******************* Globale Variablen ************************************)
  55.  
  56.   VAR
  57.  
  58.     daten                         : t_save_rec;
  59.     Route                         : t_link_array;
  60.     linkmask                      : t_lm;
  61.     digimask                      : t_dm;
  62.     ka                            : Integer;
  63.     Dummy                         : String[2];
  64.     ReadSTR, TmpSTR1              : String;
  65.     DigiFile                      : Text;
  66.     Line1, Line2                  : String[255];
  67.     call1,s                       : string;
  68.     i, Anfang, DigiA, DigiB, 
  69.     paracount                     : integer;
  70.     ausgabe                       : text;
  71.     sp_flag                       : boolean;
  72.     qual                          : real;
  73.     record_size                      : Long_Integer;
  74.     KAOS_Halt                      : long_integer;
  75.  
  76.  (************ Kleinschreibung in Groβschreibung umwandeln *****************)
  77.  
  78.   
  79.  {  Hier kommen die Deklarationen der benötigten GEMDOS - Funktionen }
  80.  
  81.  function fcreate(var name : namens_typ;attribut : integer):integer;
  82.  
  83.    gemdos($3c);
  84.    
  85.  function fopen(var name : namens_typ;modus : integer):integer;
  86.  
  87.    gemdos($3d);
  88.    
  89.  procedure fclose(handle : integer);
  90.  
  91.    gemdos($3e);
  92.    
  93.  function fread(handle : integer;anzahl : long_integer;var daten : t_save_rec):long_integer;
  94.  
  95.    gemdos($3f);
  96.    
  97.  function fwrite(handle :integer;anzahl : long_integer;var daten : t_save_rec):long_integer;
  98.  
  99.    gemdos($40);
  100.    
  101.   procedure fsetdta(var dta : dta_typ);
  102.   
  103.     gemdos($1a);
  104.     
  105.   function fsfirst(var name : namens_typ; attribut : integer): integer;
  106.   
  107.     gemdos($4e);
  108.  
  109.   function Sconfig(mode: integer; value: long_integer): long_integer;
  110.     gemdos($33);
  111.     
  112.   procedure clrscr;
  113.   
  114.     begin
  115.       write(chr(27),'E')
  116.     end;
  117.     
  118.   procedure gotoxy(x,y : integer);
  119.   
  120.     begin
  121.       write(chr(27),'Y',chr(32+y),chr(32+x))
  122.     end;
  123.     
  124.   PROCEDURE ToUpper ( VAR TmpSTR : Char );
  125.  
  126.   VAR
  127.     Num      : Integer;
  128.  
  129.   BEGIN
  130.     Num := Ord ( TmpSTR );
  131.     IF ( Num >= 97 )  THEN TmpSTR := Chr ( Num-32 )
  132.   END;
  133.  
  134.   function frac(e : real):real;
  135.   
  136.     begin
  137.       frac := e - trunc(e)
  138.     end;
  139.     
  140.   function suche_digi(diginame : string):integer;
  141.   
  142.     var              ch : char;
  143.         n,loi,mii,hii,i : integer;
  144.                      lg : real;
  145.         
  146.     begin
  147.       for i := 1 to 9 do
  148.         begin
  149.           ch := diginame[i];
  150.           toupper(ch);
  151.           diginame[i] := ch
  152.         end;
  153.       lg := ln(daten.anz_digis) / ln(2);
  154.       n := trunc(lg) + 2;
  155.       loi := 1;
  156.       hii := daten.anz_digis;
  157.       mii := (loi + hii) div 2;
  158.       i := 1;
  159.       while not((i = n) or (daten.call[mii] = diginame)) do
  160.         begin
  161.           if daten.call[mii] < diginame then loi := mii
  162.                                         else hii := mii;
  163.           mii := (loi + hii) div 2;
  164.           i := i + 1
  165.         end;
  166.       if daten.call[mii] = diginame then suche_digi := mii
  167.                                     else suche_digi := 0
  168.     end;
  169.               
  170.  (********************** Locator in QTH umrechnen **************************)
  171.  (********************** nur zur Digiroute-Kompatibilität ******************)
  172.  
  173.  PROCEDURE locator_koordinaten ( QTH : String; VAR oest_laenge, noerd_breite : Real );
  174.  
  175.  
  176.     VAR    asckor     : array[1..6] of byte;
  177.            maske      : array[1..6] of byte;
  178.            i          : integer;
  179.            WiInfo     : ARRAY[1..6] OF integer;
  180.  
  181.     BEGIN
  182.       qth := concat(qth,'       ');
  183.       if pos(' ',qth) >6  then
  184.         begin
  185.           asckor[1] := 65;   asckor[2] := 65;
  186.           asckor[3] := 48;   asckor[4] := 48;
  187.           asckor[5] := 65;   asckor[6] := 65;
  188.       
  189.           maske[1] := 223;   maske[2] := 223;
  190.           maske[3] := 255;   maske[4] := 255;
  191.           maske[5] := 223;   maske[6] := 223;
  192.       
  193.    (* Ermittlung der Indexziffern aus dem QTH-Kenner *)
  194.  
  195.           FOR i := 1 TO 6 DO
  196.             WiInfo[i] := ( Ord ( QTH[i] ) & Maske[i] ) -AscKor[i];
  197.  
  198.    (* Berechnung der geografischen Koordinate aus den Indexziffern *)
  199.  
  200.           oest_laenge := -180+WiInfo[1]*20+WiInfo[3]*2+WiInfo[5]/12+1/24;
  201.           noerd_breite := -90+WiInfo[2]*10+WiInfo[4]*1+WiInfo[6]/24+1/48
  202.         end
  203.       else 
  204.         begin
  205.           oest_laenge := 400;
  206.           noerd_breite := 400
  207.         end
  208.  
  209.     END;   
  210.  
  211.   procedure  DMS ( e:real;f : boolean; var gms : string); { Umformen Dezimalgrad }
  212.                                                           { in Grad/Minuten/Sekunden }
  213.    VAR d, m, s : INTEGER;
  214.        ds      : STRING[3];
  215.        ms      : STRING[2];
  216.        n_e_fl  : boolean;
  217.  
  218.     BEGIN
  219.       n_e_fl := e >= 0;
  220.       e := abs(e);
  221.       d := trunc (e);
  222.       if abs(d)>360 then gMS := '???'
  223.       else
  224.         begin
  225.           e := 60*FRAC(e);
  226.           m := trunc (e);
  227.           writev(ds,d);
  228.           writev(ms,m:2);
  229.           IF ms[1]=' ' THEN ms[1]:='0';
  230.          gMS := concat(ds,#248,ms,#39);
  231.          { Sekunden-Angabe ist sinnlos, Loc-Feld hat 2.5 * 5 minuten ! }
  232.          if f then
  233.            if n_e_fl then gms := concat(gms,' N')
  234.                      else gms := concat(gms,' S')
  235.          else
  236.            if n_e_fl then gms := concat(gms,' O')
  237.                      else gms := concat(gms,' W')
  238.        end
  239.     END;
  240.  
  241.  
  242.   function direct_dist(la,ba,lb,bb : real):real;
  243.   
  244.     var e,x : real;
  245.     
  246.     begin
  247.       x := SIN(ba) * SIN(bb) + COS(ba) * COS(bb) * COS(lb-la);  
  248.       if x < 1 then
  249.         begin
  250.           e := PI/2-ARCTAN ( x / SQRT (1-SQR(x) ) ) ;   { Berechnung für ARCCOS }
  251.           direct_Dist := e*6370
  252.         end
  253.       else direct_dist := 0;
  254.     end;
  255.       
  256.   FUNCTION Dist ( a,b : INTEGER ) : REAL;           { Berechnen der Entfernung }
  257.                                                     { zwischen 2 in Dezimalgrad }
  258.    VAR ba,bb,la,lb : REAL;                          { angegebenen Punkten }
  259.  
  260.     BEGIN
  261.       la := daten.OST[a]*pi/180;
  262.       ba := daten.NORD[a]*pi/180;
  263.       lb := daten.OST[b]*pi/180;
  264.       bb := daten.NORD[b]*pi/180;
  265.       dist := direct_dist(la,ba,lb,bb)
  266.     END;
  267.  
  268.  (******************* einlesen der digipeaterdaten *************************)
  269.  
  270.   procedure load_name(var name : namens_typ);
  271.   
  272.     begin
  273.       name[1]  := 'd' ; name[2]  := 'i';
  274.       name[3]  := 'g' ; name[4]  := 'i';
  275.       name[5]  := 'm' ; name[6]  := 'a';
  276.       name[7]  := 'p' ; name[8]  := '.';
  277.       name[9]  := 'f' ; name[10] := 's';
  278.       name[11] := 't' ; name[12] := chr(0)
  279.     end;
  280.     
  281.   FUNCTION Load_FST : BOOLEAN;               { Fast-Load von DG9EP }
  282.   
  283.     VAR    name   : namens_typ;
  284.            handle : integer;
  285.                 l : long_integer;
  286.              help : boolean;
  287.  
  288.     BEGIN
  289.       load_name(name);
  290.       handle := fopen(name,0);
  291.       help := handle >= 0;
  292.       if help then
  293.         begin
  294.           l := fread(handle,record_size,daten);
  295.           help := l = record_size;
  296.           if   (daten.testmaxdigi <> maxdigi) 
  297.             or (daten.testmaxlink <> maxlink) then help := false;
  298.           fclose(handle)
  299.         end;
  300.       load_fst := help
  301.     end;
  302.         
  303.   procedure save_fst;
  304.   
  305.     var   name : namens_typ;
  306.         handle : integer;
  307.              l : long_integer;
  308.         
  309.     begin
  310.       load_name(name);
  311.       handle := fcreate(name,0);
  312.       if handle >= 0 then 
  313.         begin
  314.           daten.testmaxdigi := maxdigi;
  315.           daten.testmaxlink := maxlink;
  316.           l := fwrite(handle,record_size,daten);
  317.           fclose(handle)
  318.         end
  319.     end;
  320.     
  321.  
  322.   function check_datum : boolean;
  323.   
  324.     var                       dta : dta_typ;
  325.                              name : namens_typ;
  326.                              help : boolean;
  327.                     datum1,datum2 : integer;
  328.     
  329.     begin
  330.       help := false;
  331.       fsetdta(dta);
  332.       load_name(name);
  333.       i := fsfirst(name,0);
  334.       if i <> -33 then 
  335.         begin
  336.           datum1 := dta.datum;
  337.           load_name(name);
  338.           name[9] := 'd';
  339.           name[10] := 'a';
  340.           name[11] := 't';
  341.           i := fsfirst(name,0);
  342.           if i <> -33 then
  343.             begin
  344.               datum2 := dta.datum;
  345.               help := (datum2 > datum1)
  346.             end
  347.         end;
  348.       check_datum := help
  349.     end;
  350.               
  351.   PROCEDURE Load_Digi;
  352.  
  353.   VAR
  354.  
  355.     i,j,l                     : Integer;
  356.     noerd_breite, oest_laenge : Real;
  357.     DigiFile                  : Text;
  358.     tmpstr2                   : string[255];
  359.     last_call                 : string;
  360.     flag                      : boolean;
  361.  
  362.   BEGIN
  363.     Reset ( DigiFile,'digimap.dat' );
  364.     writeln;
  365.     i := 1;
  366.     daten.anz_digis := 0;
  367.     REPEAT
  368.       REPEAT
  369.         readln(digifile,tmpstr2);
  370.         flag := tmpstr2 = '';
  371.         if not flag then
  372.         begin
  373.             j := 1;
  374.             l := length(tmpstr2);
  375.             if tmpstr2[1] <> '#' then
  376.             begin
  377.                 daten.call[i] := '';
  378.                 while not ((j>l) or (tmpstr2[j] = ',')) do
  379.                   begin 
  380.                     if length(daten.call[i]) <> 9 then daten.call[i] := concat(daten.call[i],tmpstr2[j]);
  381.                     j := j + 1
  382.                   end;
  383.                 write(daten.call[i], #13);
  384.                 if daten.call[i] < last_call then
  385.                   begin
  386.                     write(chr(27),'j');
  387.                     gotoxy(0,20);
  388.                     writeln('Warnung : Eintrag von ',daten.call[i],' nicht in alphabetischer');
  389.                     writeln('          Reihenfolge !!!');
  390.                     write(chr(27),'k')
  391.                   end
  392.                 else last_call := daten.call[i];
  393.                 j := j + 1;
  394.                 daten.qth[i] := '';
  395.                 while not ((j>l) or (tmpstr2[j] = ',')) do
  396.                 begin 
  397.                     daten.qth[i] := concat(daten.qth[i],tmpstr2[j]);
  398.                     j := j + 1
  399.                   end;
  400.                 j := j + 1;
  401.                 daten.typ[i] := '';
  402.                 while not ((j>l) or (tmpstr2[j] = ',')) do
  403.                    begin 
  404.                     if tmpstr2[j] <> ' ' then
  405.                     daten.typ[i] := concat(daten.typ[i],tmpstr2[j]);
  406.                     j := j + 1
  407.                   end;
  408.                 j := j + 2;
  409.                 daten.qrg[i] := '';
  410.                 while not ((j>l) or (tmpstr2[j] = ',')) do
  411.                   begin 
  412.                     daten.qrg[i] := concat(daten.qrg[i],tmpstr2[j]);
  413.                     j := j + 1
  414.                   end;
  415.                 j := j + 1
  416.             end;
  417.         end;
  418.       until ( ( tmpstr2[1]<>'#' )  OR ( EOF ( DigiFile ) ) );          { Kommentarzeilen überlesen }
  419.       locator_koordinaten ( daten.qth[i], daten.Ost[i], daten.Nord[i] );  
  420.       i := i+1;
  421.     UNTIL EOF ( DigiFile ) or flag;
  422.     daten.anz_digis := i-1;
  423.     Reset ( DigiFile );
  424.     Close ( DigiFile );
  425.   END;
  426.  
  427.  (***************** Berechnen der Linktabelle ******************************)
  428.  
  429.   PROCEDURE Link_Tab;
  430.  
  431.   VAR
  432.     i, l, j, Count : Integer;
  433.     di, ci         : Integer;
  434.     Anfang, Ende   : Integer;
  435.     CCall, DCall   : String[10];              { Call-Länge 9 Zeichen }
  436.     Line1, Line2   : String[255];
  437.     Info           : String;
  438.     DigiFile       : Text;
  439.     Link           : Integer;                { Gewichtung für Link-Qualität }
  440.  
  441.   BEGIN
  442.     Reset ( DigiFile,'digimap.dat' );
  443.     Count := 1;
  444.     FOR i := 1 TO daten.anz_digis DO
  445.       BEGIN
  446.         WRITE (i : 5,' , ',count : 5,' : ',daten.call[i] , #13 );                 { Mitzählen, zur Beruhigung }
  447.         REPEAT
  448.           ReadLn ( DigiFile, Line1 );
  449.         UNTIL ( ( Line1[1]<>'#' )  OR ( EOF ( DigiFile ) ) );
  450.         Anfang := Pos ( '(', Line1 );
  451.         Ende := Pos ( ')', Line1 );
  452.         Line2 := COPY ( Line1, Anfang, ( Ende+1-Anfang ) );
  453.         di := 2;
  454.         WHILE ( Line2[di] <> ')' )  DO
  455.           BEGIN
  456.             ci := 1;
  457.             CCall := '          ';
  458.             WHILE ( Line2[di] <> ',' )  AND ( Line2[di] <> ')' )  DO
  459.               BEGIN
  460.                 CCall[ci] := Line2[di];
  461.                 di := di+1;
  462.                 ci := ci+1;
  463.               END;
  464.             CASE CCall[ci-1] of
  465.               '%' : BEGIN                    { Link-Gewichtung abhängig von Baud }
  466.                      Link:=2;                { Wert für Link_Gamma }
  467.                      CCall[ci-1]:=' '        { Link-Symbol vernichten ! }
  468.                     END;
  469.               '!' : begin
  470.                      Link := 4;
  471.                      CCall[ci-1] := ' '
  472.                     end;
  473.               '?' : begin
  474.                       link := 5;
  475.                       ccall[ci-1] := ' '
  476.                     end;
  477.               '#' : BEGIN
  478.                      Link:=7;
  479.                      CCall[ci-1]:=' '
  480.                     END;
  481.               '@' : begin
  482.                       link := 10;
  483.                       ccall[ci-1] := ' '
  484.                     end;
  485.               '$' : BEGIN
  486.                      Link:=16;
  487.                      CCall[ci-1]:=' '
  488.                     END;
  489.               '&' : BEGIN
  490.                      Link:=255;
  491.                      CCall[ci-1]:=' '
  492.                     END;
  493.         otherwise : Link:=22;
  494.              END;
  495.             CCall := COPY ( CCall, 1, 9 );
  496.             IF ( Line2[di] <> ')' ) THEN di := di+1;
  497.             l := suche_digi(ccall);
  498.             if l <> 0 then
  499.               begin
  500.                 daten.link_start[Count] := i;
  501.                 daten.link_end[Count] := l;
  502.                 daten.link_gamma[Count] := Link;
  503.                 Count := Count+1;
  504.               END
  505.           end
  506.       end;
  507.     daten.anz_links := Count-1;
  508.     Reset ( DigiFile );
  509.     Close ( DigiFile );
  510.   END;
  511.  
  512.  (*************************** Autorouter starten ***************************)
  513.  (*                                                                        *)
  514.  (* diese routine ist eine umcodierung des im Buch von Helmuth Späth       *)
  515.  (*  -- AUSGEWÄHLTE OPERATIONS RESEARCH ALGORITHMEN IN FORTRAN --          *)
  516.  (* abgedruckten fortran programmes basierend auf einem algorithmus von    *)
  517.  (* dijkstra                                                               *)
  518.  (*                                                                        *)
  519.  (*  Der Programmstruktur von Pascal angepasst und mit erläuternden        *)
  520.  (*    Kommentaren versehen von Holger Flemming, DH4DAI                    *)
  521.  (**************************************************************************)
  522.  
  523.   
  524.   
  525.   PROCEDURE auto_Route ( digi_quelle, digi_ziel:integer );
  526.  
  527.     VAR
  528.          i, j, k, l, d  : Integer;
  529.          dd, max        : Integer;
  530.          kant, next, rn : ARRAY[1..MaxLink] OF Integer;
  531.          flag,flag2     : boolean;
  532.     
  533.     {   Die Arrays kant, next und rn enthalten Tabellen, die dem Router
  534.         auskünfte über einzelne Digis geben.
  535.         
  536.         
  537.         kant[digi] enthält einen Zeiger, der auf den ersten Link
  538.         in der Linktabelle zeigt, der von "digi" ausgeht. Dies wird
  539.         lediglich dazu genutzt, um während des Routens nicht sämtliche
  540.         Links durchsuchen zu müssen, ob sie von "digi" ausgehen.
  541.         
  542.         
  543.         Die Tabelle next[digi] wird während des Routens angelegt. Dabei
  544.         steht in next[digi_quelle] immer der Index des Zieldigis, des
  545.         aktuellen Links. Wählt man diesen Zieldigi des aktuellen Links 
  546.         als Index für next[digi], so erhält man den Index des Zieldigis
  547.         des letzten bearbeiteten Links. So lassen sich vorher bearbeitete
  548.         Links wiederfinden, wenn ein Link in eine Sackgasse führte oder
  549.         die Qualität zu schlecht wurde.
  550.         
  551.         rn[digi] enthält die beste Qualität, mit der "digi" erreicht 
  552.         werden konnte. Hat der Router "digi" noch nicht erreicht, so 
  553.         steht hier der vorher initialisierte Wert 9999.
  554.         Passent zu diesen qualitäten steht in der Tabelle route[digi]
  555.         der Nachbardigi, von dem aus "digi" mit der Qualität rn[digi]
  556.         erreicht werden kann.
  557.         
  558.                                                                     }
  559.                                                                     
  560.                                                                     
  561.     begin
  562.       route[1] := 0;
  563.       j := 0;
  564.       for k := 1 to daten.anz_links do  { Hier wird die Tabelle kant[digis] }
  565.         begin                     { erzeugt, die für jeden Digi       }
  566.           ka := daten.link_start[k];    { den ersten Link in der Linktabelle}
  567.           if ka <> j then         { enthält                           }
  568.             begin
  569.               kant[ka] := k;
  570.               j := ka
  571.             end
  572.         end;
  573.       max := 9999;
  574.       for i := 1 to daten.anz_digis do    { Hier werden die tabellen        }
  575.         begin                       { next[digis] und rn[digis]       }
  576.           next[i] := 0;             { initialisiert.                  }
  577.           rn[i] := max
  578.         end;
  579.       rn[digi_quelle] := 0;         { Beste qualität am Einstieg      }
  580.       i := digi_quelle;             { Anfang der Strecke              }
  581.       next[digi_quelle] := -1;      { Es gibt keinenvorherigen Digi   }
  582.       repeat
  583.         ka := kant[i];              { ka ist Zeiger auf ersten Link   }
  584.         for k := ka to daten.anz_links do { alle Links durchgehen           }
  585.           begin
  586.             if daten.link_start[k] <> i then
  587.               k := daten.anz_links        { Schon alle Links vom aktuellen  }
  588.                                     { Digi durch .                    }
  589.             else
  590.               begin
  591.                 j := daten.link_end[k];                      { j = Ziel des aktuellen Links    }
  592.                 if not (linkmask[k] or digimask[j])          { Wurde der Link oder Zieldigi auch nicht Maskiert ? }
  593.                    and ((daten.typ[j] = '3')                 { Nur über Digis, nicht über Boxen linken }
  594.                         or (j = digi_ziel))    then             { Am Ende ist alles erlaubt }
  595.                   begin
  596.                     d := rn[i] + daten.link_gamma[k];            { neue Qualität           }
  597.                     if d < rn[j] then                      { neue Qual. besser als alte ?    }
  598.                       begin
  599.                         rn[j] := d;                        { neue Qualität beim Zieldigi     }
  600.                         route[j] := i;                     { Ziel ist von Quelle aus erreichbar }
  601.                         if next[j] = 0 then                { War das Ziel schon mal erreicht ?  }
  602.                           begin
  603.                             next[j] := next[digi_quelle];  { Beim Ziel das vorherige Linkziel eintragen }
  604.                             next[digi_quelle] := j         { Bei Quelldigi aktuelles Linkziel eintragen }
  605.                           end
  606.                       end
  607.                   end
  608.               end
  609.           end;
  610.         flag := next[digi_quelle] < 0;      { Gibt es überhaupt noch einen Link ? }
  611.         if not flag then                    { Ja ! }
  612.           begin
  613.             ka := digi_quelle;
  614.             d  := max;                      { Initialisieren }
  615.             repeat
  616.               i := next[ka];                { letztes Linkziel nach ka }
  617.               dd := rn[i];                   { qualität nach dd         }
  618.               if dd < d then                { Qualität besser als vorherige }
  619.                 begin
  620.                   j := ka;                  { j zeigt jetzt auf besseren Link }
  621.                   d := dd                   { bessere Qualität }
  622.                 end;
  623.               ka := i;                      { nächster Link ausprobieren }
  624.             until next[i]<= 0;              { solange bis alle Links durch sind }
  625.             i := next[j];
  626.             next[j] := next[i]
  627.           end
  628.       until (i = digi_ziel) or flag;        { Bis das Ziel erreicht ist oder 
  629.                                               Keine Möglichkeit mehr existiert }
  630.       if not flag then
  631.         begin
  632.           ka := digi_ziel;                      { ka ist digi_ziel}
  633.           i := 1;                               { i ist Zählvariable }
  634.           repeat
  635.             rn[i] := ka;
  636.             flag2 := ka = digi_quelle;
  637.             if not flag2 then
  638.               begin
  639.                 ka := route[ka];
  640.                 i := i + 1
  641.               end
  642.           until flag2;
  643.           ka := i;
  644.           k := ka + 1;
  645.           for i := 1 to ka do
  646.             route[i] := rn[k - i]
  647.         end
  648.     end;
  649.     
  650.  (************ Ausgabe der Digipeater-Links ********************************)
  651.  
  652.   PROCEDURE Show_Links ( i : Integer );
  653.  
  654.   VAR
  655.     l : Integer;
  656.     s : integer;
  657.  
  658.   BEGIN
  659.     IF i<=daten.anz_digis THEN                 { Sicherheitsmaβnahme gegen unerklärte Abstürze ... }
  660.       FOR l := 1 TO daten.anz_links DO
  661.         BEGIN
  662.           IF ( daten.link_start[l] = i )  THEN
  663.             BEGIN
  664.               WRITE (ausgabe, daten.call[daten.link_end[l]] );
  665.               s := round(dist(daten.link_start[l],daten.link_end[l]));
  666.               if s < 0 then write(ausgabe,'   Entfernung : ----km ')
  667.                        else write(ausgabe,'   Entfernung : ',s:4,'km ');
  668.               case daten.link_gamma[l] of
  669.                   2 : writeln (ausgabe, ' Drahtstrecke ');
  670.                   4 : writeln (ausgabe, '38400 Baud');
  671.                   5 : writeln (ausgabe, '19200 Baud');
  672.                   7 : WRITELN (ausgabe, ' 9600 Baud' );
  673.                  10 : writeln (ausgabe, ' 4800 Baud');
  674.                  16 : WRITELN (ausgabe, ' 2400 Baud' );
  675.                  22 : WRITELN (ausgabe, ' 1200 Baud' );
  676.                 255 : WRITELN (ausgabe, 'in Bau/Planung' )
  677.               END
  678.             END
  679.         END
  680.   END;
  681.  
  682.  
  683.  (************ Ausgabe eines Digipeater-Links ******************************)
  684.  
  685.   PROCEDURE Show_Link ( i, j : Integer;var q,di : real );
  686.  
  687.   VAR
  688.     l : Integer;
  689.  
  690.   BEGIN
  691.     IF i<=daten.anz_digis THEN                 { Sicherheitsmaβnahme gegen unerklärte Abstürze ... }
  692.       l := 1;
  693.       while not((l > daten.anz_links) or 
  694.                ((daten.link_start[l] = i)  and (daten.link_end[l] = j))) do l := l + 1;
  695.       case daten.link_gamma[l] of
  696.           2 : write (ausgabe, '<----> ');
  697.           4 : write (ausgabe, '<38k4> ');
  698.           5 : write (ausgabe, '<19K2> ');
  699.           7 : WRITE (ausgabe, '< 9K6> ' );
  700.          10 : write (ausgabe, '< 4K8> ');
  701.          16 : WRITE (ausgabe, '< 2K4> ' );
  702.          22 : WRITE (ausgabe, '< 1K2> ' );
  703.         255 : WRITE (ausgabe, '<im Bau> ' );
  704.       END;
  705.       q := q * ((255 - daten.link_gamma[l]) / 255);
  706.       di := di + dist(i,j)
  707.   END;
  708.   
  709.   procedure kurz_anleitung;
  710.   
  711.     BEGIN
  712.       GOTOXY ( 1, 10 );
  713.       WRITELN(ausgabe,'Kurzanleitung: ' );
  714.       WRITELN(ausgabe);
  715.       writeln(ausgabe,'Anzahl der Digis : ',daten.anz_digis : 5);
  716.       writeln(ausgabe,'Anzahl der Links : ',daten.anz_links : 5);
  717.       writeln(ausgabe);
  718.       WRITELN(ausgabe,'Aufruf: - DIGIINFO <Call>          : Liefert Infos zu <Call> ' );
  719.       writeln(ausgabe,'        - DIGIINFO <Praef>         : Liefert eine Liste von Calls gemäß Prafix');
  720.       writeln(ausgabe,'        - DIGIINFO <QRG.xxx>       : Liefert eine Liste von Calls auf der QRG');
  721.       writeln(ausgabe,'        - DIGIINFO <WW-Loc>        : Liefert die Geographischen Koordinaten zu');
  722.       writeln(ausgabe,'                                     dem angegebenen Locator, sowie die ');
  723.       writeln(ausgabe,'                                     Entfernung zu diesem Standort');
  724.       WRITELN(ausgabe,'        - DIGIINFO <1> <2>         : Liefert Route von <1> zu <2>' );
  725.       writeln(ausgabe,'        - DIGIINFO <1> <2> <3>     : Liefert Route von <1> zu <2>');
  726.       writeln(ausgabe,'                                     die nicht über <3> führt');
  727.       writeln(ausgabe,'        - DIGIINFO <1> <2> <3/4>   : Liefert Route von <1> zu <2>');
  728.       writeln(ausgabe,'                                     die nicht über den Link <3>-<4> führt');
  729.       writeln(ausgabe);
  730.       writeln(ausgabe,' <1> <2> <3> und <4> sind durch Digipeaterrufzeichen zu ersetzen!');
  731.       writeln(ausgabe,' Die Anzahl der Routerbeschränkungen ist nur durch die Länge der');
  732.       writeln(ausgabe,' Kommandozeile begrenzt.');
  733.     END;
  734.  
  735.   function info_suche : boolean;
  736.   
  737.     var         i : integer;  
  738.         ostr,nstr : string;
  739.   
  740.     begin
  741.       Reset ( DigiFile,'digimap.dat' );
  742.       if suche_digi(tmpstr1) <> 0 then 
  743.         begin
  744.           FOR i := 1 TO daten.anz_digis DO
  745.             BEGIN
  746.               REPEAT                                       { Kommentarzeilen überlesen }
  747.                 ReadLn ( DigiFile, Line1 );
  748.               UNTIL ( ( Line1[1]<>'#' )  OR ( EOF ( DigiFile ) ) );
  749.               Call1 := COPY ( Line1, 1, 9 );
  750.               IF ( TmpSTR1 = Call1 )  THEN
  751.                 BEGIN
  752.                   Anfang := Pos ( '),', Line1 );
  753.                   Line2 := COPY ( Line1, Anfang+2, 60 );
  754.                   GOTOXY ( 1, 9 );
  755.                   WRITELN (ausgabe, 'Informationen zu: ', Call1 );
  756.                   WRITELN (ausgabe);
  757.                   dms(daten.ost[i],false,ostr);
  758.                   dms(daten.nord[i],true,nstr);
  759.                   writeln(ausgabe,' Koordinaten : ',ostr,'  und ',nstr);
  760.                   writeln(ausgabe);
  761.                   Show_Links ( i );
  762.                   WRITELN (ausgabe);
  763.                   WRITELN (ausgabe, 'typ   Locator    qrg      Infos' );
  764.                   IF daten.typ[i]='2' THEN WRITE (ausgabe,'BBS   ' )  
  765.                   ELSE if daten.typ[i] = '3' then WRITE (ausgabe, 'DIGI  ' )
  766.                   else if daten.typ[i] = '4' then write (ausgabe, 'DXC   ')
  767.                   else if daten.typ[i] = '5' then write (ausgabe, 'WX    ');
  768.                   WRITELN (ausgabe, daten.qth[i], ' , ', daten.qrg[i], ' , ', Line2 );
  769.                   i := daten.anz_digis;
  770.                 END
  771.             END;
  772.           info_suche := true
  773.         end
  774.       else info_suche := false
  775.     end;
  776.   
  777.   procedure praefix_suche;
  778.   
  779.     var wx,i,l : integer;
  780.           call : string;
  781.             ch : char;
  782.              f : boolean;
  783.     begin
  784.       f := false;
  785.       writeln(ausgabe);
  786.       writeln(ausgabe,'Suche nach Präfix : ');
  787.       writeln(ausgabe);
  788.       tmpstr1 := copy(tmpstr1,1,pos(' ',tmpstr1)-1);
  789.       l := length(tmpstr1);
  790.       for i := 1 to daten.anz_digis do
  791.         begin
  792.           call1 := copy(daten.call[i],1,l);
  793.           if tmpstr1 = call1 then 
  794.             repeat
  795.               f := true;
  796.               call := concat(daten.call[i],' ');
  797.               write(ausgabe,copy(daten.call[i],1,pos(' ', call ) -1 ));
  798.               if i mod 6 = 0 then writeln(ausgabe)
  799.               else write(ausgabe,' ; ');
  800.               i := i + 1;
  801.               call1 := copy(daten.call[i],1,l);
  802.             until (tmpstr1 <> call1) or (i = maxdigi)
  803.         end;
  804.       if not f then writeln(ausgabe,' Keine Information gefunden')
  805.     end;
  806.  
  807.   procedure qrg_suche;
  808.   
  809.     var j,i : integer;
  810.     
  811.     begin
  812.       j := 0;
  813.       TmpSTR1 := COPY ( TmpSTR1, 1, POS ( ' ', TMPStr1 ) -1 );           { String kürzen }
  814.       IF POS ( '.', TmpSTR1 ) =0 THEN TmpSTR1 := concat(TmpSTR1,'.');    { Dezimalpunkt anhängen }
  815.       WHILE POS ( '.', TmpSTR1 )<4 DO TmpSTR1 := concat(' ',TmpSTR1);    { und Punkt in die Mitte }
  816.       WHILE POS ( '.', TmpSTR1 )>4 DO DELETE ( TmpSTR1, 1, 1 );          { (POS=4) bringen }
  817.       WRITELN(ausgabe);
  818.       writeln(ausgabe,' Suche nach Digis auf der Frequenz :',tmpstr1,' MHz');
  819.       for i := 1 to maxdigi do
  820.         begin
  821.           if tmpstr1 = daten.qrg[i] then 
  822.             begin
  823.               write(ausgabe,copy(daten.call[i],1,pos(' ',daten.call[i])-1),' ; ');
  824.               j := j + 1;
  825.               if j mod 8 = 0 then writeln(ausgabe)
  826.             end
  827.         end;
  828.       if j = 0 then writeln(ausgabe,' Keine Digis auf dieser Frequenz gefunden !!! ')
  829.     end;
  830.   
  831.   function check_loc : boolean;
  832.   
  833.     var h : boolean;
  834.     
  835.     begin
  836.       h := true;
  837.       if not (tmpstr1[1] in ['A' .. 'Z']) then h := false;
  838.       if not (tmpstr1[2] in ['A' .. 'Z']) then h := false;
  839.       if not (tmpstr1[3] in ['0' .. '9']) then h := false;
  840.       if not (tmpstr1[4] in ['0' .. '9']) then h := false;
  841.       if not (tmpstr1[5] in ['A' .. 'Z']) then h := false;
  842.       if not (tmpstr1[6] in ['A' .. 'Z']) then h := false;
  843.       check_loc := h
  844.     end;
  845.   
  846.   procedure locator_info;
  847.   
  848.     var l,b,myb,myl,d : real;
  849.             lstr,bstr : string;
  850.                   dat : file of record
  851.                                   b,l : real
  852.                                 end;
  853.     
  854.     begin
  855.       locator_koordinaten(tmpstr1,l,b);
  856.       dms(l,false,lstr);
  857.       dms(b,true,bstr);
  858.       l := l / 180 * pi;
  859.       b := b / 180 * pi;
  860.       writeln(ausgabe);
  861.       writeln(ausgabe,'Umwandlung von Locator in Geographische Koordinaten :');
  862.       writeln(ausgabe);
  863.       writeln(ausgabe,'Ihr Locator ',tmpstr1,' entspricht den Koordinaten');
  864.       writeln(ausgabe);
  865.       writeln(ausgabe,lstr,' Länge und ',bstr,' Breite');
  866.       writeln(ausgabe);
  867.       io_check(false);
  868.       reset(dat,'digiinfo.qth');
  869.       if io_result = 0 then
  870.         begin
  871.           io_check(true);
  872.           myl := dat^.l / 180 * pi;
  873.           myb := dat^.b / 180 * pi;
  874.           d := direct_dist(l,b,myl,myb);
  875.           writeln(ausgabe,'Die Entfernung zwischen Ihrem Locator und dem Standort dieser');
  876.           writeln(ausgabe);
  877.           writeln(ausgabe,'Station beträgt : ',round(d) : 5,'km');
  878.           writeln(ausgabe)
  879.         end
  880.       else io_check(true)
  881.     end;
  882.   procedure digi_infos;
  883.   
  884.     var wx,i,l : integer;
  885.             ch : char;
  886.              f : boolean;
  887.  
  888.     BEGIN
  889.       f := true;
  890.       cmd_getarg(1,readstr);
  891.       ReadSTR:=COPY ( CONCAT (  readstr , '         ' ) , 1, 9 );
  892.       TmpSTR1 := readstr;
  893.       FOR i := 1 TO 9 DO 
  894.         begin
  895.           ch := tmpstr1[i];
  896.           ToUpper (ch);
  897.           tmpstr1[i] := ch
  898.         end;
  899.       if check_loc then locator_info
  900.       else
  901.         if tmpstr1[1] in ['1' .. '9'] then 
  902.           if tmpstr1[2] in ['1' .. '9'] then qrg_suche
  903.                                         else begin end
  904.                                       else f := info_suche;
  905.       if not f then praefix_suche;
  906.       Close ( DigiFile )
  907.     END;
  908.  
  909.  
  910.   procedure mask_digi(digi : integer);
  911.   
  912.     begin
  913.       digimask[digi] := true;
  914.     end;
  915.     
  916.   procedure mask_link(d1,d2 : integer);
  917.   
  918.     var i : integer;
  919.     
  920.     begin
  921.       for i := 1 to daten.anz_links do
  922.         begin
  923.           if (daten.link_start[i] = d1) and (daten.link_end[i] = d2) then linkmask[i] := true;
  924.           if (daten.link_start[i] = d2) and (daten.link_end[i] = d1) then linkmask[i] := true
  925.         end
  926.     end;
  927.           
  928.   procedure masking;
  929.   
  930.     var diginame1,diginame2 : string;
  931.         i,digi1,digi2,p,l   : integer;
  932.         ch                  : char;
  933.     
  934.     begin
  935.       for i := 3 to paracount do
  936.         begin
  937.           cmd_getarg(i,diginame1);
  938.           p := pos('/',diginame1);
  939.           if p=0 then 
  940.             begin
  941.               diginame1 := COPY ( CONCAT ( diginame1 , '         ' ) , 1, 9 );
  942.               digi1 := suche_digi(diginame1);
  943.               mask_digi(digi1)
  944.             end
  945.           else
  946.             begin
  947.               l := length(diginame1);
  948.               diginame2 := copy(diginame1,p+1,l-p);
  949.               diginame1 := copy(diginame1,1,p-1);
  950.               diginame1 := COPY ( CONCAT ( diginame1 , '         ' ) , 1, 9 );
  951.               diginame2 := COPY ( CONCAT ( diginame2 , '         ' ) , 1, 9 );
  952.               digi1 := suche_digi(diginame1);
  953.               digi2 := suche_digi(diginame2);
  954.               mask_link(digi1,digi2)
  955.             end
  956.         end
  957.     end;
  958.     
  959.   procedure routing;
  960.   
  961.     var  i : integer;
  962.         ch : char;
  963.         entf1,entf2 : real;
  964.         
  965.     BEGIN
  966.       GOTOXY ( 1, 10 );
  967.       cmd_getarg(1,tmpstr1);
  968.       TmpSTR1 := COPY ( CONCAT ( tmpstr1 , '         ' ) , 1, 9 );
  969.       digia := suche_digi(tmpstr1);
  970.       cmd_getarg(2,tmpstr1);
  971.       TmpSTR1 := COPY ( CONCAT ( tmpstr1 , '         ' ) , 1, 9 );
  972.       digib := suche_digi(tmpstr1);
  973.       if paracount > 2 then masking;
  974.       ka := Link_Depth + 1;
  975.       IF ( ( DigiA<>0 )  AND ( DigiB<>0 ) )
  976.         THEN auto_Route ( DigiA, DigiB );         { Kein Routing wenn falsche Eingabe }
  977.       IF ( ka < Link_Depth )  THEN
  978.         BEGIN
  979.           WRITE (ausgabe, daten.call[DigiA] );
  980.           WRITE (ausgabe, 'connect to  ' );
  981.           WRITEln (ausgabe, daten.call[DigiB] );
  982.           IF ka > 2 THEN                                { Kein Pfad wenn direkt ! }
  983.             BEGIN
  984.               qual := 1;
  985.               entf1 := 0;
  986.               WRITELN (ausgabe);
  987.               FOR i := 1 TO ka-1 DO
  988.                 BEGIN
  989.                   WRITE (ausgabe, COPY ( daten.call[Route[i]], 1, POS ( ' ', daten.call[Route[i]] ) ) );
  990.                   if i mod 6 = 0 then writeln(ausgabe);
  991.                   Show_Link ( Route[i], Route[i+1],qual,entf1 )
  992.                 END;
  993.               WRITELN (ausgabe, daten.call[Route[ka]] );
  994.             END
  995.             else
  996.             entf1 := dist(route[1],route[ka]);
  997.           entf2 := dist(route[1],route[ka]);
  998.           writeln(ausgabe);
  999.           writeln(ausgabe,'Die Entfernung zwischen beiden Digis beträgt : ',round(entf2) : 5,'km');
  1000.           writeln(ausgabe,'            Die gesammte Linkdistanz beträgt : ',round(entf1) : 5,'km');
  1001.           writeln(ausgabe);
  1002.           writeln(ausgabe,'    Das Entfernungsverhältnis ist : ',round(entf2 / entf1 * 100),'%');
  1003.           WRITELN(ausgabe); WRITELN (ausgabe, 'Qualität: ', round(Qual*100),'%' );
  1004.         END
  1005.       ELSE
  1006.         BEGIN
  1007.           IF ( ( DigiA<>0 )  AND ( DigiB<>0 ) )  THEN
  1008.             BEGIN
  1009.               WRITE (ausgabe, daten.call[DigiA] );                    { Auch Ausgabe, wenn nichts gefunden }
  1010.               WRITE (ausgabe, 'connect to  ' );
  1011.               WRITELN (ausgabe, daten.call[DigiB] );
  1012.             END;
  1013.           WRITELN(ausgabe);
  1014.           WRITELN (ausgabe, 'Kein Connect möglich' );
  1015.         END;
  1016.    END;
  1017.  
  1018.    procedure erstelle_fst;
  1019.    
  1020.      BEGIN
  1021.        GOTOXY ( 5, 9 );WRITELN (ausgabe, 'digipeater loading' );
  1022.        Load_digi;                                      (* Digipeater vom Datenfile einlesen *)
  1023.        GOTOXY ( 5, 10 );WRITELN (ausgabe, 'building Link table' );
  1024.        Link_Tab;                                       (* Linktabelle erstellen *)
  1025.        Save_FST;
  1026.        GOTOXY ( 5, 9 );WRITELN (ausgabe, '                  ' );
  1027.        GOTOXY ( 5, 10 );WRITELN (ausgabe, '                   ' );
  1028.        writeln(ausgabe,'                     ');
  1029.      END;
  1030.  
  1031.  (********************************* Hauptprogramm ****************************)
  1032.  
  1033.   BEGIN
  1034.     paracount := cmd_args;
  1035.     if paracount > 2 then
  1036.       begin
  1037.         cmd_getarg(paracount-2,s);         { Drittletzten Parameter holen }
  1038.         sp_flag :=  length(s) < 3          { Wurde Programm von SP aus aufgerufen }
  1039.       end;
  1040.  
  1041.     record_size := sizeof(daten);
  1042.  
  1043.     if sp_flag then rewrite(ausgabe,'out.txt')
  1044.                else rewrite(ausgabe,'CON:');
  1045.     for i := 0 to maxdigi do digimask[i] := false;
  1046.     for i := 0 to maxlink do linkmask[i] := false;
  1047.     if not sp_flag then CLRSCR;
  1048.     GOTOXY ( 5, 3 );WRITELN (ausgabe, 'DIGI - INFO ',Version );
  1049.     GOTOXY ( 3, 5 );WRITELN (ausgabe, 'by Holger Flemming, DH4DAI ',Date );
  1050.     GOTOXY ( 3, 6 );writeln(ausgabe,'mal wieder modifiziert von DC7OS');
  1051.     gotoxy(2,7);writeln(ausgabe,' Nach einem MS DOS - Programm von Patrik Sesseler, DF3VI ');
  1052.     writeln(ausgabe);
  1053.     if check_datum then erstelle_fst
  1054.                    else if not load_fst then erstelle_fst;
  1055.     if sp_flag then paracount := paracount - 3; { Die letzten 3 Para. sind zu vernachläßigen }
  1056.          CASE paracount of 
  1057.            0 : kurz_anleitung;
  1058.            1 : digi_infos;
  1059.    otherwise : routing
  1060.          end;
  1061.     KAOS_Halt := Sconfig(0,$100);
  1062.     if KAOS_Halt > 0 then KAOS_Halt := (KAOS_Halt div $100) mod 2
  1063.                      else KAOS_Halt := 1;
  1064.     if (not sp_flag) and (KAOS_Halt = 1) then
  1065.       begin
  1066.         gotoxy(24,24);
  1067.         write(' Zurück zum Desktop mit <Return>');
  1068.         readln
  1069.       end
  1070.   END.
  1071.  
  1072. (DH4DAI) DH4DAI de DB0SGL>